perm filename IO[XGP,BGB] blob
sn#023235 filedate 1973-02-04 generic text, type T, neo UTF8
00100 SUBR(GETFIL)------------------------------------------------------
00200 BEGIN GETFIL;SETUP FILE SPEC FROM TTY LINE - BGB - 10 DEC 72.
00300 SETZM FILNAM↔SETZM EXTION↔SETZM EXTION+1↔SETZM PPPN
00400 OUTSTR[ASCIZ/ FILE = /]
00500 LAC 1,[POINT 6,FILNAM,-1]↔LACI 2,6
00600 INCHWL↔CAIN 15↔GO[INCHWL↔POP2J]↔AOSA(P)
00700 L: INCHWL
00800 CAIN"."↔GO[LAC 1,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
00900 CAIN"["↔GO[LAC 1,[POINT 6,PPPN,-1] ↔LACI 2,3↔GO L]
01000 CAIN","↔GO[LAC 1,[POINT 6,PPPN,17] ↔LACI 2,3↔GO L]
01100 CAIN"]"↔GO L
01200 CAIN 15↔GO EOL ;END OF THE LINE.
01300 CAIN 12↔GO EOL
01400 CAIG" "↔GO L ;IGNORE GARBAGE.
01500 SOJL 2,L↔SUBI 40↔IDPB 1↔GO L
01600
01700 EOL: INCHWL
01800 SKIPN 1,EXTION↔LAC 1,ARG2↔DAC 1,EXTION
01900 SKIPN FLGBGB↔POP2J
02000 ;BGB'S DEFAULT PROJECT SPECIFICATION.
02100 SKIPN 1,PPPN↔ LAC 1,ARG1↔DAC 1,PPPN
02200 POP2J
02300 BEND;12/10/72------------------------------------------------------
02400
02500 FILNAM: 0 ;FILE NAME.
02600 EXTION: 0 ;EXTENSION.
02700 0
02800 PPPN: 0 ;PROJECT-PROGRAMMER.
00100 SUBR(TVDSKI)------------------------------------------------------
00200 BEGIN TVDSKI;INPUT TV PICTURE FROM A DISK FILE - BGB 6 DEC 72.
00300 CALL(GETFIL,[SIXBIT/TMP/],[0])↔POP0J
00400 CALL(SEGTV)
00500 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00600 LOOKUP 1,FILNAM↔GO[OUTSTR[ASCIZ/ LOOKUP FAILED.
00700 /]↔GO .+4]
00800 IN 1,DUMARG↔JFCL
00900 OUTSTR[ASCIZ" EOF.
01000 "]↔ RELEASE 1,
01100 POP0J
01200 DUMARG: IOWD 24400,HEADER↔0
01300 BEND;12/14/72-----------------------------------------------------
01400
01500 SUBR(TVDSKO)------------------------------------------------------
01600 BEGIN TVDSKO;INPUT TV PICTURE FROM A DISK FILE - BGB 6 DEC 72.
01700 CALL(GETFIL,[SIXBIT/TMP/],[0])↔POP0J
01800 CALL(SEGTV)
01900 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
02000 ENTER 1,FILNAM↔GO[OUTSTR[ASCIZ/ ENTER FAILED.
02100 /]↔GO .+4]
02200 OUT 1,DUMARG↔JFCL
02300 OUTSTR[ASCIZ" EOF.
02400 "]↔ RELEASE 1,
02500 POP0J
02600 DUMARG: IOWD 24400,HEADER↔0
02700 BEND;12/14/72-----------------------------------------------------
00100
00200 SUBR(PLOTO)-------------------------------------------------------
00300 BEGIN PLOTO;DISPLAY BUFFER TO DISK FILE - BGB 10 DEC 1972.
00400 CALL(GETFIL,[SIXBIT/PLT/],[0])↔POP0J
00500 LAC 1,DPYBUF↔LACN(1)1↔SUBI 2
00600 CDR 2,(1)↔SETZM 1(2)
00700 MOVS↔LAPI -1(1)↔DAC DUMLST
00800 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00900 ENTER 1,FILNAM↔GO .+4
01000 OUT 1,DUMLST↔JFCL
01100 OUTSTR[ASCIZ" EOF.
01200 "]↔ RELEASE 1,
01300 POP0J
01400 DUMLST: 0↔0
01500 BEND;12/10/72------------------------------------------------------
00100 SUBR(TVXGP)-------------------------------------------------------
00200 BEGIN TVXGP; VIDEO BUFFER TO XEROX GRAPHICS PRINTER.
00300 ;BGB - 19 JANUARY 1973.
00400 ;ONE TO SIXTEEN EXPANSION: 216*4=864 BY (288*4=1152 OR 32 WORDS)
00500 ;XGP BUFFER SIZE 28513 = 864 LINES * 33 WORDS PER LINE + 1.
00600 ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2}
00700
00800 ;EXPAND CORE FOR XGP BUFFER.
00900 LAC 44↔DAC SAV44#↔ADDI =28513↔IORI 1777
01000 CALLI 11↔GO L4↔CALL(SEGTV)
01100 CDR 1,SAV44↔SETZM(1)↔DIP 1,1↔AOS 1↔CDR 2,44↔BLT 1,(2)
01200
01300 ;PUT CONTROL WORD IN EACH ROW.
01400 LAC[1B11+=192B23+=32]↔LAC 1,SAV44↔AOS 1↔LACI 2,=864
01500 DAC(1)↔ADDI 1,=33↔SOJG 2,.-2↔SLACI 577000↔DAC(1)
01600
01700 LAC P1,[POINT 6,TVBUF,-1]
01800 LAC P2,SAV44↔ADDI P2,2
01900 LACI I,=216
02000 L1: LACI J,=32
02100 L2: SETZB 0,1↔SETZB 2,3
02200 LACI K,=9
02300 L3: ILDB Q,P1↔CAMGE Q,HCUT↔SETZ Q,↔SKIPE Q↔LACI Q,70
02400 ROTC 0,4↔ROTC 2,4
02500 IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)↔IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
02600 SOJG K,L3
02700 DAC 0,=00(P2)↔DAC 1,=33(P2)↔DAC 2,=66(P2)↔DAC 3,=99(P2)
02800 AOS P2
02900 SOJG J,L2
03000 ADDI P2,=100
03100 SOJG I,L1
03200
03300 DETSEG
03400 ;GRAB THE DEVICE.
03500 INIT 1,17↔SIXBIT/XGP/↔0↔GO[OUTSTR[
03600 ASCIZ/ CAN'T INIT XGP.
03700 /]↔ POP0J]
03800 LAC SAV44↔DAP DUMARG↔DAP DUMARG+1↔DAP DUMARG+2
03900 OUT 1,DUMARG↔RELEASE 1,
04000 LAC SAV44↔CALLI 11
04100 L4: OUTSTR[ASCIZ/ NOT ENUF CORE FOR XGP BUFFER.
04200 /]↔ CRLF↔POP0J
04300 DUMARG: XWD -=28513,0
04400 XWD -=28513,0
04500 XWD -=28513,0↔0
04600
00100 ;HALF TONE TABLE.
00200 HTT:
00300 17↔17↔17↔17 ; 2 LINES HORIZONTAL TOGETHER. 0
00400 00↔17↔00↔17 ; 2 LINES HORIZONTAL 1
00500 06↔06↔06↔06 ; 2 LINES VERTICAL TOGETHER 2
00600 00↔07↔07↔07 ; 9 DOTS TOGETHER 3
00700
00800 11↔06↔06↔11 ; BOTH DIAGONAL 4
00900 00↔17↔07↔00 ; 8 DOTS TOGETHER 5
01000 00↔00↔07↔07 ; 6 DOTS TOGETHER 6
01100 00↔06↔06↔00 ; 4 DOTS TOGETHER 7
01200
01300 17↔00↔00↔00 ; 1 LINE HORIZONTAL 10
01400 10↔10↔10↔10 ; 1 LINE VERTICAL 11
01500 10↔04↔02↔01 ; 1 LINE DIAGONAL 12
01600 00↔07↔00↔00 ; 3 DOTS TOGETHER 13
01700
01800 00↔03↔00↔00 ; 2 DOTS TOGETHER 14
01900 00↔01↔00↔40 ; 2 DOTS APART 15
02000 00↔01↔00↔00 ; 1 DOT 16
02100 00↔00↔00↔00 ; NOTHING. 17
02200
02300 BEND;1/19/73-------------------------------------------------------
00100 SUBR(CREOUT)------------------------------------------------------
00200 BEGIN CREOUT; CONTOUR,REGION,EDGE FILE FORMAT OUTPUT.
00300 ;BGB - 6 DECEMBER 1972.
00400 LAC CTRL↔AND META↔SKIPE↔GO FONTO
00500 SKIPN CTRL↔GO TVDSKO
00600
00700 CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
00800 CALL(SHRINK)
00900 LACN FILM↔CALL(RELLOC,0)
01000
01100 ;SETUP DUMP OUT ARGUMENT IOWD.
01200 LAC FILM↔SUB@AVAIL
01300 LACM 1,0↔MOVSS
01400 LAP OLD44↔DAC OUTARG
01500 LAC@FILM↔DAC TMP#↔DAC 1,@FILM ;FILE SIZE IN WORDS.
01600
01700 ;FILE OUTPUT RITUAL.
01800 LAC@AVAIL↔SUB FILM↔DAC@AVAIL
01900 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
02000 ENTER 1,FILNAM
02100 GO[OUTSTR[ASCIZ/ ENTER FAILED.
02200 /]↔GO .+4]
02300 OUT 1,OUTARG↔JFCL
02400 OUTSTR[ASCIZ" EOF.
02500 "]↔ RELEASE 1,
02600 SETZM FILNAM↔SETZ EXTION↔SETZM EXTION+1↔SETZM PPPN
02700 CALL(RELLOC,FILM)
02800 LAC TMP↔DAC@FILM
02900 LAC@AVAIL↔ADD FILM↔DAC@AVAIL
03000 POP0J
03100 OUTARG: 0↔0
03200 BEND;1/28/73------------------------------------------------------
00100 SUBR(CREIN)-------------------------------------------------------
00200 BEGIN CREIN; CONTOUR,REGION,EDGE FILE FORMAT INPUT.
00300 ;BGB - 28 JANURAY 1973.
00400 LAC CTRL↔AND META↔SKIPE↔GO FONTI
00500 SKIPN CTRL↔GO TVDSKI
00600 CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
00700 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00800 LOOKUP 1,FILNAM↔JFCL
00900
01000 SETZM QBLK
01100 LAC PPPN↔LAP FILM↔SOS↔DAC INARG ;IOWD
01200
01300 MOVS PPPN↔MOVMS↔ADD FILM
01400 IORI 1777↔CAMG 44↔GO L1
01500 CALLI 11↔HALT
01600 LAC 44↔AOS↔SUB FILM↔DIVI 7↔DAC 1,REMAINDER
01700 L1: IN 1,INARG
01800 RELEASE 1,
01900 OUTSTR[ASCIZ" EOF.
02000 "]↔ RELEASE 1,
02100 SETZM FILNAM↔SETZM EXTION↔SETZM EXTION+1↔SETZM PPPN
02200
02300 CDR@AVAIL↔ADD FILM↔DAC@AVAIL↔SETZM@
02400 DIP↔AOS↔LAC 1,44↔BLT(1) ;CLEAR EMPTY AREA.
02500 CALL(RELLOC,FILM)
02600
02700 ;RESET AVAIL LIST.
02800 LAC 1,@AVAIL↔LAC 2,44
02900 LIPI 1,NODSIZ(1)↔GO L6
03000 L5: HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
03100 L6: CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
03200 SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
03300
03400 CALL(DPYIMG)
03500 POP0J
03600 INARG: 0↔0
03700 BEND;1/28/73------------------------------------------------------
00100 SUBR(FONTI)-------------------------------------------------------
00200 BEGIN FONTI;FONT FILE INPUT - BGB - 1 FEBRUARY 1973.
00300
00400 CALL(GETFIL,[SIXBIT/XAP/],[0])↔POP0J
00500 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00600 LOOKUP 1,FILNAM↔JFCL
00700 LAC PPPN↔LAPI $↔SOS↔DAC INARG ;IOWD.
00800 MOVS PPPN↔MOVMS↔ADDI $↔CORE2↔HALT ;MAKE UPPER SEG.
00900 LAC[SIXBIT/FNTSEG/]↔CALLI $+36↔JFCL ;NAME UPPER SEG.
01000 IN 1,[INARG:0↔0]
01100 RELEASE 1,
01200 POP0J
01300
01400 BEND;2/1/73-------------------------------------------------------
01500
01600 SUBR(FONTO)-------------------------------------------------------
01700 BEGIN FONTO;FONT FILE OUTPUT - BGB - 1 FEBRUARY 1973.
01800 EXTERN ENDPTR
01900 CALL(GETFIL,[SIXBIT/XAP/],[0])↔POP0J
02000 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
02100 ENTER 1,FILNAM↔JFCL
02200 LAC ENDPTR↔SUBI $-1↔MOVNS↔DIP OUTARG
02300 LACI $-1↔DAP OUTARG
02400 OUT 1,OUTARG
02700 RELEASE 1,
02800 POP0J
02900 OUTARG: 0↔0
03000
03100 BEND;2/1/73-------------------------------------------------------
00100 SUBR(RELLOC)BASE--------------------------------------------------
00200 BEGIN RELLOC;RELOCATE ALL POINTERS - BGB - 6 DECEMBER 1972.
00300 ACCUMULATORS{A,B,C,D}
00400 DEFINE KAR(Q){CAR Q(A)↔SKIPE↔ADD B↔DIP Q(A)↔GO .+1}
00500 DEFINE KDR(Q){CDR Q(A)↔SKIPE↔ADD B↔DAP Q(A)↔GO .+1}
00600
00700 LAC B,ARG1 ;BASE ADDRESS.
00800 LAC A,FILM ;BLOCK POINTER.
00900
01000 L1: SKIPN(A)2↔GO[KDR 0↔GO L2] ;EMPTY BLOCK.
01100
01200 RELOC D,A↔TRNE D,400000↔LACI D,333333
01300 TRNE D,200000↔GO[KAR 0]↔ TRNE D,100000↔GO[KDR 0]
01400 TRNE D,20000 ↔GO[KAR 1]↔ TRNE D,10000 ↔GO[KDR 1]
01500 TRNE D,2000 ↔GO[KAR 3]↔ TRNE D,1000 ↔GO[KDR 3]
01600 TRNE D,200 ↔GO[KAR 4]↔ TRNE D,100 ↔GO[KDR 4]
01700 TRNE D,20 ↔GO[KAR 5]↔ TRNE D,10 ↔GO[KDR 5]
01800 TRNE D,2 ↔GO[KAR 6]↔ TRNE D,1 ↔GO[KDR 6]
01900
02000 L2: ADDI A,7+7↔CAML A,44↔POP1J
02100 SUBI A,7
02200 GO L1
02300 LIT
02400 BEND;12/20/72-----------------------------------------------------
00100 SUBR(TVIN4)------------------------------------------------------
00200 BEGIN TVIN4; FOUR BIT TELEVISION INPUT - BGB - 14 DEC 1972.
00300
00400 L0: INIT 17,17↔SIXBIT/TV/↔0
00500 GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
00600 SETZM TVERR↔INPUT 17,TVPTR↔RELEASE 17,
00700
00800 ;REPORT ON THE ERROR BITS AND RETAKE IF NECESSARY;
00900 LAC 1,TVERR
01000 TRNE 1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
01100 /]↔ TRNE 1,40 ↔OUTSTR[ASCIZ/TV DATA MISS.
01200 /]↔ TRNE 1,20 ↔OUTSTR[ASCIZ/TV NON EX MEM.
01300 /]↔ TRNE 1,100060↔JRST L0
01400 CALLI 22↔DAC TVTIME#
01500 CALLI 14↔DAC TVDATE#
01600
01700 LAC[XWD HISTO,HISTO+1]↔SETZM HISTO↔BLT HISTO+77
01800 SETZM FTVSIX↔SETOM FTVHIS
01900
02000 ;CONVERT FROM GREY CODE TO GRAY CODE.
02100 LAC 16,[XWD L,0]↔BLT 16,12
02200 LAP TVPTR↔GO 4
02300
02400 L: POINT 4,0,-1↔ FROM←←0
02500 POINT 6,TVBUF,-1↔ TO←←1
02600 =62208 ↔ CNT←←2
02700 0 ↔ BYT←←3
02800 ILDB BYT,FROM ;4
02900 LAC BYT,GRAY(BYT) ;3
03000 LSH BYT,2 ;6
03100 AOS HISTO(BYT) ;7
03200 IDPB BYT,TO ;8
03300 SOJG CNT,4 ;9
03400 POP0J ;12
03500
03600 BEND;12/16/72-----------------------------------------------------
03700
03800 TVPTR: XWD -=6912,0
03900 TVCLIP: 703002 ;BCLIP=7 TCLIP=0 CAM=3.
04000 TVYXW: BYTE(9)50,34,40
04100 TVERR: 0
04200 GRAY: OCT 12,13,11,10,15,14,16,17,5,4,6,7,2,3,1,0
00100 SUBR(TVCAMI)------------------------------------------------------
00200 BEGIN TVCAMI;TELEVISION CAMERA INPUT - BGB - 14 DEC 1972.
00300 LAC 44↔DAC TMP44#↔AOS↔DAP TVPTR
00400 ADDI =6912↔SKIPE CTRL↔ADDI 3*=6912
00500 CALLI 11↔GO[FATAL(NO CORE FOR TVTAKE.)]
00600 CALL(SEGTV)
00700 LAC[XWD TVBUF,TVBUF+1]
00800 SETZM TVBUF↔BLT TVBUF+=10367
00900 CALL(TVIN4)
01000 LAC TMP44↔CALLI 11↔JFCL
01100 CRLF↔POP0J
01200 BEND;12/16/72-----------------------------------------------------
00100 SUBR(CAMERA)------------------------------------------------------
00200 BEGIN CAMERA
00300 OUTSTR[ASCIZ/ CAMERA = /]
00400 INCHRW
00500 ANDI 3
00600 LSH 9
00700 IORI 700002
00800 DAC TVCLIP
00900 CRLF
01000 POP0J
01100 BEND;12/6/72------------------------------------------------------